home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / BORL_TIP / TI2000 / TI2593.ASC < prev    next >
Text File  |  1994-09-19  |  4KB  |  180 lines
  1.  
  2.  
  3.  
  4.  
  5.  
  6.  
  7.   PRODUCT  :  Pascal                                 NUMBER  :  2593
  8.   VERSION  :  All
  9.        OS  :  Windows
  10.      DATE  :  August 10, 1994                          PAGE  :  1/3
  11.  
  12.     TITLE  :  Enabling a horizontal scroll bar for a list box.
  13.  
  14.  
  15.  
  16.  
  17. program HorizontalListBox;
  18.  
  19. uses
  20.     WinTypes, WinProcs, OWindows, ODialogs, Strings;
  21.  
  22. const
  23.   id_ListBox1 = 101;
  24.  
  25. type
  26.   ListBoxApp = Object (TApplication)
  27.     procedure InitMainWindow; Virtual;
  28.   end;
  29.  
  30.   PHListBox = ^THListBox;
  31.   THListBox = object(TListBox)
  32.       procedure SetupWindow; virtual;
  33.   end;
  34.  
  35.   PMainWindow = ^TMainWindow;
  36.   TMainWindow = Object(TWindow)
  37.     ListBox1: PHListBox;
  38.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  39.     procedure SetupWindow; virtual;
  40.   end;
  41.  
  42. procedure TMainWindow.SetupWindow;
  43. var
  44.   dc: Hdc;
  45.   StringLength, Count, I: Byte;
  46.   Tmp, StringSize: LongInt;
  47.   lbString: PChar;
  48.  
  49. begin
  50.   inherited SetupWindow;
  51.   dc := GetDC(hWindow);
  52.   StringLength := 0;
  53.   {Add strings to the list box.}
  54.   ListBox1^.AddString('This is line 1');
  55.  
  56.  
  57.  
  58.  
  59.  
  60.  
  61.  
  62.  
  63.  
  64.  
  65.  
  66.  
  67.   PRODUCT  :  Pascal                                 NUMBER  :  2593
  68.   VERSION  :  All
  69.        OS  :  Windows
  70.      DATE  :  August 10, 1994                          PAGE  :  2/3
  71.  
  72.     TITLE  :  Enabling a horizontal scroll bar for a list box.
  73.  
  74.  
  75.  
  76.  
  77.   ListBox1^.AddString('This is line 2, which is really long');
  78.   ListBox1^.AddString('This is line 3');
  79.   ListBox1^.AddString('This is line 4');
  80.   ListBox1^.AddString('This is line 5');
  81.   ListBox1^.AddString('This is line 6');
  82.   ListBox1^.AddString('This is line 7');
  83.   ListBox1^.AddString('This is line 8');
  84.   ListBox1^.AddString('This is line 9');
  85.   {Count the number of strings inside the list box.}
  86.   Count := ListBox1^.GetCount;
  87.   if Count > 0 then
  88.   begin
  89.     GetMem(lbString, 255);
  90.     {Look at each string in the list box and determine
  91.      the size of the largest one.}
  92.     for I := 0 to Count - 1 do
  93.     begin
  94.       StringSize := ListBox1^.GetString(lbString, I);
  95.       if StringSize <= 0 then
  96.       begin
  97.         MessageBox(HWindow, 'An error occured extracting string', 
  98.         'ERROR',mb_Ok or mb_IconExclamation);
  99.         Break;
  100.       end
  101.       else
  102.       begin
  103.         {The lo word return from GetTextExtent holds the width
  104.          in pixels of the string.}
  105.         Tmp := loWord(GetTextExtent(dc, lbString, StringSize));
  106.         if Tmp > StringLength then
  107.           StringLength := Tmp;
  108.       end;
  109.     end;
  110.     FreeMem(lbString, 255);
  111.     {Add one upper case character length to the total length of
  112.     the largest string length .  This allows the list box to
  113.     scroll just beyond the last character in the larges string.}
  114.     inc(StringLength, LoWord(GetTextExtent(dc, 'X', 1)));
  115.  
  116.  
  117.  
  118.  
  119.  
  120.  
  121.  
  122.  
  123.  
  124.  
  125.  
  126.  
  127.   PRODUCT  :  Pascal                                 NUMBER  :  2593
  128.   VERSION  :  All
  129.        OS  :  Windows
  130.      DATE  :  August 10, 1994                          PAGE  :  3/3
  131.  
  132.     TITLE  :  Enabling a horizontal scroll bar for a list box.
  133.  
  134.  
  135.  
  136.  
  137.     {Send a lb_SetHorizontalExtent to the list box.}
  138.     SendMessage(ListBox1^.HWindow, lb_SetHorizontalExtent,
  139.                 StringLength, 0);
  140.   end
  141.   else
  142.     MessageBox(HWindow, 'An error occured.  The list box
  143.      has no strings in it.','ERROR', mb_Ok or mb_IconExclamation);
  144.   ReleaseDC(hWindow, dc);
  145. end;
  146.  
  147. procedure THListBox.SetupWindow;
  148. begin
  149.     inherited SetupWindow;
  150.     Attr.Style := Attr.Style or WS_HSCROLL;
  151. end;
  152.  
  153. constructor TMainWindow.Init (AParent: PWindowsObject; ATitle: PChar);
  154. begin
  155.   Inherited Init (AParent, ATitle);
  156.   ListBox1 := New(PHListBox, Init(@Self, id_ListBox1,
  157.                    15, 15, 120, 100));
  158. end;
  159.  
  160. procedure ListBoxApp.InitMainWindow;
  161. begin
  162.   MainWindow := New(PMainWindow, Init(nil,
  163.                     'Example of a Horizontal Scrolling List Box'));
  164. end;
  165.  
  166. var
  167.   MyApplication: ListBoxApp;
  168.  
  169. begin
  170.   MyApplication.Init('Min');
  171.   MyApplication.Run;
  172.   MyApplication.Done;
  173. end.
  174.  
  175.  
  176. DISCLAIMER: You have the right to use this technical information
  177. subject to the terms of the No-Nonsense License Statement that
  178. you received with the Borland product to which this information
  179. pertains.
  180.